home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
comm
/
suncom.zip
/
ANSIDRV.PAS
next >
Wrap
Pascal/Delphi Source File
|
1989-09-30
|
6KB
|
157 lines
{***************************************************************************}
{* <<< LiveSystems AnsiDriver >>> *}
{* *}
{* Release date 19-3-89 *}
{* Written by G.Hoogterp (Fidonet 2:2/102.6) *}
{* (BitNet HoogterpG@Hentht51) *}
{* *}
{* (c) CopyRight LiveSystems LiveSystems 1989,1990 *}
{* *}
{* ALL RIGHTS RESERVED, NO GARANTIES :USE IT AT YOURE ONE RISK ! *}
{***************************************************************************}
{***************************************************************************}
{* this ansi drive supports the following codes : *}
{* *}
{* Esc[nA : Cursor up *}
{* Esc[nB : Cursor Down *}
{* Esc[nC : Cursor right *}
{* Esc[nD : Cursor Left *}
{* *}
{* Esc[y;xf *}
{* Esc[y;xH Cursor at Y,X *}
{* *}
{* Esc[2J Clear Screen *}
{* Esc[K Clear to end of line *}
{* *}
{* Esc[p1;..;pnm Set graphics parameters *}
{* *}
{* *}
{* It also knows the codes : *}
{* *}
{* Esc[=nh Set Screen type *}
{* Esc[=nl Reset Screen type *}
{* Esc[6n Report current cursor position *}
{* Esc[y;xR Report current cursor as y,x *}
{* Esc[s Save cursor position *}
{* Esc[u Restore cursor position *}
{* *}
{* But these codes are not used and not displayed... *}
{* *}
{***************************************************************************}
Unit AnsiDrv;
Interface
Uses dos,Crt;
Procedure AnsiDriver(Key : Char);
Implementation
Const AnsiEndChars = 'ABCDfHhJKlmnpRsu';
Type Str10 = String[10];
Var AnsiBuffer : Array[0..255] Of Char;
AnsiPtr : Byte;
RecAnsi : Boolean;
MemAttr : Byte;
Procedure AnsiDriver(Key : Char);
Var Tel : Byte;
AnsiBeg : Byte;
AnsiStr : Str10;
Procedure DoAnsiControle(AnsiNr : Byte;AnsiStr : Str10);
Var Value : Byte;
XVal,
YVal : Byte;
Err : Word;
Const ForColors : Array[0..7] Of Byte = (0,4,2,14,1,5,3,15);
BackColors : Array[0..7] Of Byte = (0,4,2,6,1,5,3,7);
Begin
Case AnsiNr Of
1,
2,
3,
4 : Begin
If AnsiStr<>''
Then Val(AnsiStr,Value,Err)
Else Value:=1;
Case AnsiNr Of
1 : GotoXy(WhereX,WhereY-Value);
2 : GotoXy(WhereX,WhereY+Value);
3 : GotoXy(WhereX+Value,WhereY);
4 : GotoXy(WhereX-Value,WhereY);
End;
End;
5,
6 : Begin
Val(Copy(AnsiStr,1,Pos(';',AnsiStr)-1),YVal,Err);
Delete(AnsiStr,1,Pos(';',AnsiStr));
Val(AnsiStr,XVal,Err);
GotoXy(XVal,YVal);
End;
8 : ClrScr;
9 : ClrEol;
11 : Begin
Repeat
If Pos(';',AnsiStr)>0
Then Begin
Val(Copy(AnsiStr,1,Pos(';',AnsiStr)-1),Value,Err);
Delete(AnsiStr,1,Pos(';',AnsiStr));
End
Else Begin
Val(AnsiStr,Value,Err);
AnsiStr:='';
End;
Case Value Of
0 : TextAttr:=MemAttr;
1..3 :;
5,6 : TextAttr:=TextAttr Or $80;
7 : TextAttr:=TextAttr Xor $7F;
8 :;
30..37 : TextColor(ForColors[Value-30]);
40..47 : TextBackGround(Backcolors[Value-40]);
48,49 :;
End; {Case}
Until AnsiStr='';
End;
End; {Case}
End;
Begin
If Key=#27
Then Begin
AnsiPtr:=0;
RecAnsi:=True;
End;
If Not RecAnsi
Then Write(Key);
Ansibuffer[AnsiPtr]:=Key;
If Boolean(Pos(Key,AnsiEndChars)) And (AnsiBuffer[0]=#27)
Then Begin
Move(AnsiBuffer[1],AnsiStr,AnsiPtr-1);
AnsiStr[0]:=Chr(AnsiPtr-2);
If Pos(Key,'lpnRsu')=0
Then DoAnsiControle(Pos(Key,AnsiEndChars),AnsiStr);
AnsiPtr:=0;
RecAnsi:=False;
End
Else Inc(AnsiPtr);
End;
Var Inp : File Of Char;
Key : Char;
Begin
MemAttr:=TextAttr;
AnsiPtr:=0;
RecAnsi:=False;
Fillchar(AnsiBuffer,255,0);
End.